home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / lisp / replace.jl < prev    next >
Lisp/Scheme  |  1995-03-09  |  6KB  |  178 lines
  1. ;;;; replace.jl -- Commands for replacing text
  2. ;;;  Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'replace)
  21.  
  22. ;; From isearch.jl
  23. (defvar case-fold-search t)
  24. (make-variable-buffer-local 'case-fold-search)
  25.  
  26.  
  27. ;;;###autoload
  28. (defun replace-all (from template)
  29.   "Replace all occurrences of the regexp FROM with the expansion from TEMPLATE
  30. for that particular occurrence (see the `replace-regexp' function for details
  31. of what can be in TEMPLATE)."
  32.   (interactive "sReplace regexp:\nsReplace regexp %s with:")
  33.   (let
  34.       (match)
  35.     (goto-buffer-start)
  36.     (while (setq match (find-next-regexp from nil nil case-fold-search))
  37.       (goto-char (replace-regexp from template match nil case-fold-search)))))
  38.  
  39.  
  40. ;;; Query replace
  41.  
  42. (defvar query-replace-keymap (make-keylist))
  43. (bind-keys query-replace-keymap
  44.   "SPC" 'query-replace-replace
  45.   "y" 'query-replace-replace
  46.   "BS" 'query-replace-skip
  47.   "n" 'query-replace-skip
  48.   "," 'query-replace-replace-and-wait
  49.   "RET" 'query-replace-exit
  50.   "ESC" 'query-replace-exit
  51.   "q" 'query-replace-exit
  52.   "." 'query-replace-once-only
  53.   "!" 'query-replace-rest
  54.   "^" 'query-replace-backtrack
  55.   "Ctrl-r" 'query-replace-edit
  56.   "Ctrl-w" '(progn (query-replace-delete) (query-replace-edit))
  57.   "?" 'query-replace-help
  58.   "HELP" 'query-replace-help
  59.   "Ctrl-h" 'query-replace-help)
  60.  
  61. (defun query-replace-replace ()
  62.   (interactive)
  63.   (goto-char (replace-regexp query-replace-from query-replace-to nil nil
  64.                  case-fold-search))
  65.   (throw 'query-replace))
  66.  
  67. (defun query-replace-skip ()
  68.   (interactive)
  69.   (when (looking-at query-replace-from nil nil case-fold-search)
  70.     (goto-char (match-end)))
  71.   (throw 'query-replace))
  72.  
  73. (defun query-replace-replace-and-wait ()
  74.   (interactive)
  75.   (goto-char (replace-regexp query-replace-from query-replace-to nil nil
  76.                  case-fold-search))
  77.   (message query-replace-title))
  78.  
  79. (defun query-replace-exit ()
  80.   (interactive)
  81.   (setq query-replace-alive nil)
  82.   (throw 'query-replace))
  83.  
  84. (defun query-replace-once-only ()
  85.   (interactive)
  86.   (goto-char (replace-regexp query-replace-from query-replace-to nil nil
  87.                  case-fold-search))
  88.   (query-replace-exit))
  89.  
  90. (defun query-replace-rest ()
  91.   (interactive)
  92.   (goto-char (replace-regexp query-replace-from query-replace-to nil nil
  93.                  case-fold-search))
  94.   (let
  95.       (match)
  96.     (while (setq match (find-next-regexp query-replace-from nil nil
  97.                      case-fold-search))
  98.       (goto-char (replace-regexp query-replace-from query-replace-to match nil
  99.                  case-fold-search)))
  100.     (setq query-replace-alive nil)
  101.     (throw 'query-replace)))
  102.  
  103. (defun query-replace-edit ()
  104.   (interactive)
  105.   (setq keymap-path query-replace-old-kp)
  106.   (remove-hook 'unbound-key-hook 'query-replace-unbound-key-fun)
  107.   (let
  108.       ((buf (current-buffer))
  109.        (esc-means-meta t))
  110.     (unwind-protect
  111.     (recursive-edit)
  112.       (with-buffer buf
  113.     (setq keymap-path '(query-replace-keymap))
  114.     (add-hook 'unbound-key-hook 'query-replace-unbound-key-fun))))
  115.   (throw 'query-replace))
  116.  
  117. (defun query-replace-delete ()
  118.   (interactive)
  119.   (when (looking-at query-replace-from nil nil case-fold-search)
  120.     (delete-area (match-start) (match-end))))
  121.  
  122. (defun query-replace-backtrack ()
  123.   (interactive)
  124.   (if (cdr query-replace-trace)
  125.       (progn
  126.     (setq query-replace-trace (cdr query-replace-trace))
  127.     (goto-char (car query-replace-trace)))
  128.     (beep))
  129.   (message query-replace-title))
  130.     
  131. (defun query-replace-unbound-key-fun ()
  132.   (beep)
  133.   (message query-replace-title))
  134.  
  135. ;;;###autoload
  136. (defun query-replace (query-replace-from query-replace-to)
  137.   "Command to interactively replace all occurrences of the regexp
  138. QUERY-REPLACE-FROM with the expansion of the template QUERY-RFEPLACE-TO.
  139. If FROM or TO are not given they are prompted for.
  140.   As each occurrence is found the editor pauses, waiting for the user to
  141. type one of the following special commands,\n
  142.   `SPC', `y'         replace this occurrence and find the next
  143.   `BS', `n'          ignore this occurrence and search for the next
  144.   `,'                replace this match and wait for another command
  145.   `RET', `ESC', `q'  exit the query-replace
  146.   `.'                replace this occurrence then exit the query-replace
  147.   `!'                replace all matches from here to the end of the buffer
  148.   `^'                return to the previous match
  149.   `Ctrl-r'           enter a recursive edit (`ESC Ctrl-c' to exit)
  150.   `Ctrl-w'           delete the match, then enter a recursive edit
  151.   `Ctrl-h'           show some help text"
  152.   (interactive "sQuery replace regexp: \nsQuery replace regexp %s with: ")
  153.   (let
  154.       ((query-replace-trace nil)
  155.        (query-replace-alive t)
  156.        (query-replace-old-kp keymap-path)
  157.        (query-replace-title (concat "Query replacing " query-replace-from
  158.                     " with " query-replace-to ": "))
  159.        (buf (current-buffer))
  160.        (esc-means-meta nil)        ; want to bind to ESC
  161.        match)
  162.     (add-hook 'unbound-key-hook 'query-replace-unbound-key-fun)
  163.     (setq keymap-path '(query-replace-keymap))
  164.     (unwind-protect
  165.     (while (and query-replace-alive
  166.             (setq match
  167.               (find-next-regexp query-replace-from nil
  168.                         nil case-fold-search)))
  169.       (goto-char match)
  170.       (setq query-replace-trace (cons match query-replace-trace))
  171.       (catch 'query-replace
  172.         (message query-replace-title)
  173.         (recursive-edit)))
  174.       (with-buffer buf
  175.     (setq keymap-path query-replace-old-kp)
  176.     (remove-hook 'unbound-key-hook 'query-replace-unbound-key-fun)))
  177.     (message "Done.")))
  178.